BBS in a Box 4/BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso/Files/Prog/M/MYWINDOW.PAS

Pascal/Delphi Source File | 1987-04-26 | 10.9 KB | 356 lines | [TEXT/MACA]

PROGRAM my_window;

               { QDSample -- Macintosh adaptation of Lisa QuickDraw example. }
                                { by Paul Zemlin, Macintosh Technical Support}

                                      { Modified for Turbo Pascal, June 1986 }

{$R mywindow.rsrc}
{$U-}

   USES Memtypes,QuickDraw,OSIntf,ToolIntf;           {toolbox programs used}

   TYPE
      IconData = ARRAY[0..95] OF INTEGER;             { a 'type' created
                                                 especially for this program}

   CONST
      lastMenu = 2;                                        { number of menus }
      appleMenu = 1;                       { menu ID for desk accessory menu }
      fileMenu = 256;                                { menu ID for File menu }

   VAR
      myMenus                           : ARRAY [1..lastMenu] OF MenuHandle;
      dragRect ,prect, growrect         : Rect;
      doneFlag,temp                     : BOOLEAN;
      myEvent                           : EventRecord;
      code, refNum, MyControl,t         : INTEGER;
      theMenu, theItem, whichIcon       : INTEGER;
      scale                             : INTEGER;
      wRecord                           : WindowRecord;
      theWindow, whichWindow            : WindowPtr;
      icons                             : ARRAY[0..5] OF IconData;
      hScroll, vScroll, whichControl    : ControlHandle;
      theOrigin                         : Point;
      theUpdateRgn                      : RgnHandle;





   PROCEDURE MoveScrollBars;  {this procedure will be looked for when invoked
                                by subsequent procedure involving the window}

      BEGIN
         WITH theWindow^.portRect DO
            BEGIN
            HideControl(vScroll);
            MoveControl(vScroll,right-15,top-1);
            SizeControl(vScroll,16,bottom-top-13);
            ShowControl(vScroll);
            HideControl(hScroll);
            MoveControl(hScroll,left-1,bottom-15);
            SizeControl(hScroll,right-left-13,16);
            ShowControl(hScroll)
            END
      END;

   PROCEDURE ResizePRect;          { pRect is the window's content region,
                                     minus the scroll bars }

      BEGIN
         pRect := thePort^.portRect;
         pRect.right := pRect.right-15;
         pRect.bottom := pRect.bottom-15
      END;

   PROCEDURE GrowWnd (whichWindow: WindowPtr);

                    { Handles growing and sizing the window and manipulating }
                                        { the update region. }

      VAR
         longResult: LongInt;
         height,width: INTEGER;
         tRect: Rect;

      BEGIN
         longResult := GrowWindow(whichWindow,myEvent.where,growRect);
         IF longResult=0 THEN EXIT;
         height := HiWord(longResult); width := LoWord(longResult);

         { Add the old "scroll bar area" to the update region so it will }
         { be redrawn (for when the window is enlarged). }
         tRect := whichWindow^.portRect;
         tRect.left := tRect.right - 15;
         InvalRect(tRect);
         tRect := whichWindow^.portRect;
         tRect.top := tRect.bottom - 15;
         InvalRect(tRect);


         { Now draw the newly sized window. }


         SizeWindow(whichWindow,width,height,TRUE);
         MoveScrollBars;
         ResizePRect;

         { Add the new "scroll bar area" to the update region so it will }
         { be redrawn (for when the window is made smaller). }

         tRect := whichWindow^.portRect; tRect.left := tRect.right-15;
         InvalRect(tRect);
         tRect := whichWindow^.portRect; tRect.top := tRect.bottom-15;
         InvalRect(tRect);
      END; { of GrowWnd }

   PROCEDURE DrawWindow(whichWindow: WindowPtr);
   { Draws the content region of theWindow }

      VAR
         tRect    : Rect;

      BEGIN

         ClipRect (theWindow^.portRect);
         DrawGrowIcon(theWindow);
         IF theWindow = FrontWindow THEN DrawControls(theWindow);

         { Now set up a clip area which excludes the scroll bars }


         tRect := theWindow^.portRect;
         tRect.bottom := tRect.bottom - 15;
         tRect.right := tRect.right - 15;

         {Now compensate for any scrolling which has been done }

         OffsetRect (tRect, theOrigin.h, theOrigin.v);
         ClipRect (tRect);

         { Change the origin to compensate for any scrolling which has
          been done }

         SetOrigin (theOrigin.h, theOrigin.v);

         SetOrigin (0, 0);
         ClipRect (theWindow^.portRect);            { Reset the clip area }
       END; { of DrawWindow }

   PROCEDURE ScrollBits;

      VAR
         oldOrigin   : point;
         dh,dv       : INTEGER;
         tRect       : Rect;

      BEGIN
            oldOrigin := theOrigin;
            theOrigin.h := 4 * GetCtlValue(hScroll);
            theOrigin.v := 4 * GetCtlValue(vScroll);
            dh := oldOrigin.h - theOrigin.h;
            dv := oldOrigin.v - theOrigin.v;
            theUpdateRgn := NewRgn;
            ScrollRect (pRect, dh, dv, theUpdateRgn);

            { Have scrolled in junk...need to redraw }

            SetOrigin (theOrigin.h, theOrigin.v);
            OffsetRect (theUpdateRgn^^.rgnBBox, theOrigin.h, theOrigin.v);
            ClipRect (theUpdateRgn^^.rgnBBox);

            DisposeRgn (theUpdateRgn);
            SetOrigin (0, 0);
            ClipRect (theWindow^.portRect);
      END;

   PROCEDURE ScrollUp(whichControl: ControlHandle; theCode: INTEGER);

      BEGIN
         IF theCode=inUpButton THEN
            BEGIN
            SetCtlValue(whichControl,GetCtlValue(whichControl)-1);
            ScrollBits
            END
      END;

   PROCEDURE ScrollDown(whichControl: ControlHandle; theCode: INTEGER);

      BEGIN
         IF theCode=inDownButton THEN
            BEGIN
            SetCtlValue(whichControl,GetCtlValue(whichControl)+1);
            ScrollBits
            END
      END;

   PROCEDURE PageScroll(code,amount: INTEGER);

      VAR
         myPt: point;

      BEGIN
         REPEAT
            GetMouse(myPt);
            IF TestControl(whichControl,myPt)=code THEN
               BEGIN
               SetCtlValue(whichControl,GetCtlValue(whichControl)+amount);
               ScrollBits
               END
         UNTIL NOT StillDown;
      END;

   PROCEDURE SetUpMenus;
   { Once-only initialization for menus }

      VAR
         i: INTEGER;

      BEGIN
         InitMenus; { initialize Menu Manager }
         myMenus[1] := GetMenu(appleMenu);
         AddResMenu(myMenus[1],'DRVR'); { desk accessories }
         myMenus[2] := GetMenu(fileMenu);
         FOR i := 1 TO lastMenu DO InsertMenu(myMenus[i],0);
         DrawMenuBar;
      END; { of SetUpMenus }


   PROCEDURE DoCommand(mResult: LongInt);

      VAR
         name: STR255;

      BEGIN
         theMenu := HiWord(mResult); theItem := LoWord(mResult);
         CASE theMenu OF

            appleMenu:
               BEGIN
               GetItem(myMenus[1],theItem,name);
               refNum := OpenDeskAcc(name);
               END;

            fileMenu: doneFlag := TRUE; { Quit }


         END; { of menu case }

         HiliteMenu(0);

      END; { of DoCommand }

   BEGIN { main program }
      InitGraf(@thePort);
      InitFonts;
      FlushEvents(everyEvent,0);
      InitWindows;
      SetUpMenus;
      InitDialogs(NIL);
      SetCursor(arrow);
      SetRect(dragRect,4,24,508,338);
      SetRect(growRect,100,60,512,302);
      doneFlag := FALSE;
      InitCursor;


      theWindow := GetNewWindow(256,@wRecord,POINTER(-1));
      SetPort(theWindow);
      theWindow^.txFont := 2;

      ResizePRect;

      vScroll := GetNewControl(256,theWindow);
      hScroll := GetNewControl(257,theWindow);
      theOrigin.h := 0; theOrigin.v := 0;


      REPEAT
         SystemTask;
         temp := GetNextEvent(everyEvent,myEvent);
         CASE myEvent.what OF

            mouseDown:
               BEGIN
               code := FindWindow(myEvent.where,whichWindow);
               CASE code OF

                  inMenuBar: DoCommand(MenuSelect(myEvent.where));

                  inSysWindow: SystemClick(myEvent,whichWindow);

                  inDrag: DragWindow(whichWindow,myEvent.where,dragRect);

                  inGoAway:
                     IF TrackGoAway(whichWindow,myEvent.where) THEN
                        doneFlag := TRUE;

                  inGrow:
                     IF whichWindow=FrontWindow THEN
                        GrowWnd(whichWindow)
                     ELSE
                        SelectWindow(whichWindow);

                  inContent:
                     BEGIN
                     IF whichWindow<>FrontWindow THEN
                        SelectWindow(whichWindow)
                     ELSE
                        BEGIN {front}
                        GlobalToLocal(myEvent.where);
                        IF  NOT PtInRect(myEvent.where,pRect) THEN
                           BEGIN {controls}
                           MyControl := FindControl(myEvent.where,whichWindow,
                                                    whichControl);
                           CASE MyControl OF
                              inUpButton:
                                 t := TrackControl(whichControl,myEvent.where,
                                                   @ScrollUp);
                              inDownButton:
                                 t := TrackControl(whichControl,myEvent.where,
                                                   @ScrollDown);
                              inPageUP: PageScroll(MyControl,-10);
                              inPageDown: PageScroll(MyControl,10);
                              inThumb:
                                 BEGIN
                                 t := TrackControl(whichControl,myEvent.where,
                                      NIL);
                                 ScrollBits
                                 END
                           END {Case MyControl}
                           END {controls}
                        END {front}
                     END {in Content}
               END; { of code case }
               END; { of mouseDown }

            activateEvt:
               BEGIN
               SetPort (theWindow);
               DrawGrowIcon(theWindow);
               IF ODD(myEvent.modifiers) THEN { window is becoming active }
                  BEGIN
                  ShowControl(vScroll);
                  ShowControl(hScroll);
                  END
               ELSE
                  BEGIN
                  HideControl(vScroll);
                  HideControl(hScroll)
                  END
               END; { of activateEvt }

            updateEvt:
               BEGIN
               BeginUpdate(theWindow);
               EraseRect (theWindow^.portRect);
               DrawWindow(theWindow);
               EndUpdate(theWindow);
               END { of updateEvt }

         END { of event case }

      UNTIL doneFlag
   END.